home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 3
/
Cream of the Crop 3.iso
/
comm
/
aprs30_1.zip
/
MAPFIX.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-12-02
|
30KB
|
669 lines
REM MAPFIX.bas PROGRAM. SEE EXPLAINATION BELOW
REM
MaxNumMAPS = 99' Current maximum number of maps loaded by APRS
MaxNumPoints = 1000
MaxNumLABELS = 99
GOTO BEGIN
Info: COLOR 15, 1: CLS
PRINT " MAPFIX.bas VERSION 3.05 PROGRAM FOR FIXING APRS MAPS": PRINT
PRINT " MAPFIX 2.10 allowed you to add, move and delete points. Ver 3.01 allowed you"
PRINT " to add complete features! And now 3.05 allows you to KILL complete features,"
PRINT " including deleting all points in a feature. It also has a TRIM command for"
PRINT " removing all points and labels outside of a specified boundary. This comand"
PRINT " is useful for removing points to begin a new smaller map."
PRINT " CAUTION, THIS PROGRAM IS NOT PERFECT... KEEP BACKUPS! Do a little at a time!"
PRINT
PRINT " The original purpose of this program was to simply display new maps so you"
PRINT " could alternatively EDIT the map file and use MAPFIX to look at it and measure"
PRINT " locations and points. Operating in the full QBasic environment, you could "
PRINT " keep both the MAPFIX program and the MAP file online simultanously and switch"
PRINT " back and forth. Without QB, you must alternatively use EDIT and QBasic."
PRINT
PRINT " MAPFIX uses two cursors. The normal yellow APRS cursor, and a White MapPoint"
PRINT " which will be the next point to be processed. ALT Keys allow you to MOVE the"
PRINT " MapPoint to the cursor, ADD a new point at the cursor, or DELETE the MapPoint."
PRINT " MAPFIX.bas shows you decimal values of the cursor position, which are needed"
PRINT " if you want to use an editor for placing map labels in the MAP file."
PRINT
PRINT " ALSO NOTE THAT THE LIMITS IN APRS ARE 1000 POINTS, 99 FEATURES, and 99 LABELS!"
PRINT " If you need more points, features or labels, begin another map.";
LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
GOSUB GetChar: BEEP
Info2: COLOR 15, 8: CLS
PRINT " PAGE 2 INSTRUCTIONS: More about new features in version 3.05"
PRINT
PRINT " With this new MAPFIX.bas, you can not only modify features by moving, adding"
PRINT " or deleting POINTS, but you can now add and kill FEATURES too, ie: roads,"
PRINT " rivers, borders, etc, from within the program. In addition to the new KILL"
PRINT " and TRIM commands, the G key will move the cursor (GOTO) to the MapPoint,"
PRINT " and the F key will FIND the MapPoint nearest the cursor location. If the"
PRINT " MapPointer and FeatureName get out of sequence, the RESET command may fix"
PRINT " them, but you should save the file immediately and check it with an editor."
PRINT
PRINT " I find the capability to delete points very useful when making larger area"
PRINT " maps from several smaller detail maps. First, I run MAPCNVRT.bas to convert"
PRINT " all of the smaller maps to new temporary files with the new origin of the new"
PRINT " larger map. Then I use the KILL command in MAPFIX to eliminate all minor "
PRINT " roads, features and labels and then the DELETE POINT command to remove all"
PRINT " inconsequential minor points from the roads that will not be needed"
PRINT " at the larger scale. Then I use the editor to combine all of the points and"
PRINT " labels into the new file."
PRINT
PRINT " A new MAPLIST command shows your MAPLIST.map file; and the OTHER MAPS command"
PRINT " shows all MAP borders so you can see how your new map fits in. You may use F3"
PRINT " and F4 keys to select smaller or larger map borders to draw."
PRINT
Display$ = "UNKnown"
RETURN
GetChar: a$ = "": DO UNTIL a$ <> "": a$ = INKEY$: LOOP: RETURN
BEGIN: GOSUB Info:
PRINT " HIT ANY KEY to proceed onto the HELP screen...";
GOSUB GetChar
DIM x%(2 * MaxNumPoints), y%(2 * MaxNumPoints)
REM MAP coordinates **** THESE ARE BIGGER THAN APRS ***
DIM LN$(150) ' (no limit in APRS) **** SO YOU CAN MANIPULATE BIG MAPS
nn = 2 * MaxNumLABELS
DIM ML$(nn), MLa(nn), MLo(nn), MLr(nn) 'Map Labels, lengths and coordinates
nn = 2 * MaxNumMAPS
DIM MapName$(nn), LATcen(nn), LONcen(nn), MapMax(nn), Comment$(nn)
RdsOn = -1: Labls = -1: Tags = -1: KP = 1: Changed = 0: MapSize = 256
INIT: ON ERROR GOTO ErrorTrap
ScrnType$ = "EGA": Ycen = 200: Yfactr = 1: YfacTXT = 350 / 350: SCREEN 9
IF ScrnType$ = "EGA" THEN COLOR 15, 0
REM ScrnType$ = "CGA": Yfactr=200/400:Ycen = 200*Yfactr: SCREEN 2
Display$ = "HELP": GOSUB HELP: GOSUB LoadMap
REM ON ERROR GOTO 0
Main: GOSUB DrwMPaCur
DO
GoAgain: LET a$ = INKEY$
IF a$ <> "" THEN
a$ = UCASE$(a$): Key$ = a$
IF a$ = "S" THEN GOSUB labels
IF a$ = "L" THEN Labls = NOT Labls
IF a$ = "T" THEN Tags = NOT Tags
IF a$ = "F" THEN GOSUB FindPoint
IF a$ = "G" THEN GOSUB CurToPoint: GOSUB CurDrwMap
IF a$ = "H" THEN
IF Display$ <> "HELP" THEN
GOSUB HELP
ELSE GOSUB Info
LOCATE 25, 1: PRINT " H for HELP or SPACE BAR for map..."; : a$ = ""
END IF
END IF
IF a$ = "D" THEN GOSUB MapDIR
IF a$ = "M" THEN GOSUB ListMAPlist
IF a$ = "O" THEN GOSUB DrwAndShow
IF a$ = "N" THEN GOSUB NextLine: GOSUB cursor
IF a$ = "P" THEN GOSUB Previous: GOSUB cursor
IF a$ = "Q" THEN GOSUB QUIT
IF a$ = "R" THEN Z = 2: LNptr = 1
IF a$ = " " THEN Display$ = "MAP": GOSUB DrwMPaCur
IF a$ = "+" THEN Z = Z + 1: GOSUB MapPoint ' moves to next map point
IF a$ = "-" THEN Z = Z - 1: GOSUB MapPoint ' moves backwards
B$ = "": IF LEN(a$) = 2 THEN B$ = RIGHT$(a$, 1): REM process arrow & special keys
IF B$ = "I" THEN RS = RS * 2: GOSUB CurDrwMap: REM change scale
IF B$ = "Q" THEN RS = RS / 2: GOSUB CurDrwMap
IF B$ = CHR$(132) THEN RS = RS * 8: GOSUB CurDrwMap: REM change scale by factor of 4
IF B$ = "V" THEN RS = RS / 8: GOSUB CurDrwMap
IF B$ = "G" THEN GOSUB CurDrwMap 'Home key
IF a$ = "7" THEN CDX = LONo: CDY = LATo: GOSUB DrwMPaCur 'ShiftHOME
IF B$ = "O" THEN CDX = LONcen: CDY = LATcen: GOSUB DrwMPaCur 'End Key
IF B$ = "M" THEN CPX = CPX - 4 / (KP * ppdV): GOSUB cursor
IF B$ = "K" THEN CPX = CPX + 4 / (KP * ppdV): GOSUB cursor
IF B$ = "H" THEN CPY = CPY + 4 / (KP * ppdV): GOSUB cursor
IF B$ = "P" THEN CPY = CPY - 4 / (KP * ppdV): GOSUB cursor
REM Here are the special MapFIx routines
IF B$ = CHR$(30) THEN GOSUB MakeRoom 'alt-ADD point
IF B$ = CHR$(50) THEN GOSUB MakePT 'alt-MOVE point to cursor
IF B$ = CHR$(32) THEN GOSUB DelPT: GOSUB DrawMap 'alt-DELete point
IF B$ = CHR$(38) THEN GOSUB AddLabel 'alt-ADD LABEL
IF B$ = CHR$(46) THEN GOSUB NewCenter 'alt-CENTER
IF B$ = CHR$(37) THEN GOSUB KillF 'alt-KILL Feature
IF B$ = CHR$(19) THEN GOSUB MapRange 'alt-RANGE
IF B$ = CHR$(20) THEN GOSUB Trim 'alt-TRIM
IF B$ = CHR$(49) THEN GOSUB NewFeature 'alt-NEW Feature
IF B$ = CHR$(61) THEN 'F3 for smaller Maps
MapSize = MapSize / 2: IF MapSize < 1 THEN MapSize = 1
GOSUB ShowMaps
END IF
IF B$ = CHR$(62) THEN 'F4 for larger Maps
MapSize = MapSize * 2: IF MapSize > 1000 THEN MapSize = 1000
GOSUB DrwAndShow
END IF
IF a$ = CHR$(19) THEN GOSUB SaveMap
IF a$ = "6" THEN CPX = CPX - 20 / (KP * ppdV): GOSUB cursor'SHIFT Cursor by 4
IF a$ = "4" THEN CPX = CPX + 20 / (KP * ppdV): GOSUB cursor
IF a$ = "8" THEN CPY = CPY + 20 / (KP * ppdV): GOSUB cursor
IF a$ = "2" THEN CPY = CPY - 20 / (KP * ppdV): GOSUB cursor
END IF
LOOP
SYSTEM 'you should never get here
QUIT: a$ = "Y"
IF Changed THEN
GOSUB BoxLine23
PRINT "**** MAP HAS BEEN MODIFIED"; Changed; "TIMES BUT NOT SAVED!!! SAVE NOW? (Y)";
INPUT a$
IF UCASE$(a$) <> "N" THEN GOSUB SaveMap
END IF
SYSTEM
Trim: GOSUB BoxLine23
CLS : PRINT "TRIM ALL POINTS AND LABELS OUTSIDE OF MAPRANGE"
PRINT
PRINT "This command will remove all points and labels that are outside of the white"
PRINT "map border. You can change the location of this map border by using"
PRINT "the CENTER command (alt-C) and by changing the RANGE using alt-R."
PRINT : PRINT
PRINT "No map feature will be completely eliminated..."
PRINT
PRINT "The first and last point of any FEATURE will be retained, so the"
PRINT "result will be long single lines for all FEATURES outside the map border."
PRINT "Use the KILL FEATURE (alt-K) to eliminate those lines and use the MOVE"
PRINT "command (alt-M) to move any far away points closer to the border."
PRINT : PRINT
PRINT "You might consider stopping now and doing a SAVE (ctrl-S) before proceeding."
PRINT : PRINT
INPUT "Are you ready to proceed? (Y/N) (N)"; a$
IF UCASE$(a$) <> "Y" THEN GOTO DrawMap
C = 0: PRINT : PRINT "Processing...";
REM dx and dy are num pix of center of map
REM bx and by are borders of map based on MapRng
FOR Z = 1 TO nmp - 4
IF x%(Z) = 0 THEN Z = Z + 2
IF x%(Z) > dx + bx OR y%(Z) > dy + by THEN bad = 1 ELSE bad = 0
IF x%(Z) < dx - bx OR y%(Z) < dy - by THEN bad = 1
IF bad AND x%(Z - 1) <> 0 AND x%(Z + 1) <> 0 THEN
GOSUB DelPT: Z = Z - 1
C = C + 1: IF INT(C / 10) = C / 10 THEN PRINT ".";
END IF
NEXT Z
PRINT : PRINT "Now removing labels...";
FOR i = 1 TO nml: REM now eliminate all labels outside
bad = 0: Xm = MapRng / (60 * Lfac): Ym = MapRng / 60
IF MLo(i) > LONcen + Xm OR MLa(i) > LATcen + Ym THEN bad = 1
IF MLo(i) < LONcen - Xm OR MLa(i) < LATcen - Ym THEN bad = 1
IF bad = 1 THEN
FOR j = i TO nml
ML$(j) = ML$(j + 1): MLa(j) = MLa(j + 1)
MLo(j) = MLo(j + 1): MLr(j) = MLr(j + 1)
NEXT j: nml = nml - 1: PRINT ".";
END IF
NEXT i
GOTO DrawMap
FindPoint: CurX = INT(.5 + dx + (CUX - 320) / KP)
CurY = INT(.5 + dy + (CUY - Ycen) / KP)
FOR j = 0 TO 10: REM go through 10 times looking for closest point.
REM first time with no delta, then up to +1 10
LNctr = 0
FOR i = 1 TO nmp
IF x%(i) = 0 THEN LNctr = LNctr + 1
IF x%(i) > CurX - j AND x%(i) < CurX + j THEN
IF y%(i) > CurY - j AND y%(i) < CurY + j THEN
Z = i: LNptr = LNctr: GOSUB CurToPoint
j = 10: i = nmp
END IF
END IF
NEXT i:
NEXT j
GOSUB MapPoint: RETURN
NewFeature: LOCATE 24, 1: PRINT SPACE$(27); : GOSUB BoxLine23
INPUT "Enter reference name for new feature"; a$
IF a$ = "" THEN RETURN
LOCATE 25, 1
FOR i = 0 TO 14
PRINT RIGHT$(" " + MID$(STR$(i + 1), 2), 2); " ";
LINE (16 + i * 40, 335 * YfacTXT)-(40 + i * 40, 349 * YfacTXT), i + 1, BF
NEXT i
GOSUB BoxLine23
INPUT "Select color (4,7,10-Hwys 11-Water 12-Hwy 13-Spcl 14-City)"; B$
a = VAL(B$): IF a > 15 OR a < 1 THEN RETURN
x%(nmp) = 0: y%(nmp) = a 'Store feature color 0,c
LN$(LNi + 1) = LN$(LNi): LNptr = LNi'Bump up present LN$ comment
LN$(LNi) = a$: LNi = LNi + 1'Store feature name
nmp = nmp + 1: Z = nmp
nmp = nmp + 1: x%(nmp) = 0: y%(nmp) = 0'nmp points to ending 0,0
GOSUB MakePT
LOCATE 23, 1
PRINT "NOW MOVE CURSOR AND USE ALT-A TO ADD POINTS TO THIS NEW FEATURE...";
RETURN
NewCenter: LATcen = CPY: LONcen = CPX: Changed = Changed + 1: GOTO CurDrwMap
MapRange: GOSUB BoxLine23: INPUT "Enter map range"; a$
IF VAL(a$) <> 0 THEN MapRng = VAL(a$)
Changed = Changed + 1: GOTO DrwMPaCur
MakeRoom: nmp = nmp + 1: Z = Z + 1
FOR i = nmp TO Z STEP -1
x%(i) = x%(i - 1): y%(i) = y%(i - 1)
NEXT
MakePT: x%(Z) = dx + (CUX - 320) / KP
y%(Z) = dy + (CUY - Ycen) / KP
Changed = Changed + 1: GOTO DrawMap
CurToPoint:
CPX = CDX - (x%(Z) - dx) / ppdV
CPY = CDY - (y%(Z) - dy) / (ppdV * Yfactr)
GOTO cursor
DelPT: GOSUB DelZ
REM if 1st pt, it stays as 1st pt
IF x%(Z) = 0 THEN Z = Z - 1: REM if end pt, it stays as end
IF x%(Z + 1) = 0 AND x%(Z - 1) = 0 THEN 'It is LAST point
GOSUB Kline: LNptr = LNptr - 1 'So Kill Line
GOSUB DelZ 'And Kiil it
Z = Z - 1: GOSUB DelZ: Z = Z - 1 'Kill 0,color
END IF 'and -1 to end point
RETURN
DelZ: nmp = nmp - 1
FOR i = Z TO nmp
x%(i) = x%(i + 1): y%(i) = y%(i + 1)
NEXT: Changed = Changed + 1: RETURN
NextLine: IF Z >= nmp - 1 THEN Z = nmp - 1: BEEP: RETURN
DO UNTIL x%(Z) = 0: Z = Z + 1: LOOP
IF Z < nmp - 1 THEN Z = Z + 1: LNptr = LNptr + 1
GOTO MapPoint
Previous: DO UNTIL Z = 1 OR x%(Z) = 0: Z = Z - 1: LOOP
IF Z > 3 THEN Z = Z - 1: LNptr = LNptr - 1
GOTO MapPoint
KillF: Bi = Z: Changed = Changed + 1
DO UNTIL x%(Bi) = 0: Bi = Bi - 1: LOOP: Z = Bi + 1
REM Stop at Beginning (0) point of the feature to kill
Ni = Bi + 1' Now scan for next feature
DO UNTIL x%(Ni) = 0: Ni = Ni + 1: LOOP
REM now move down rest of array to fill
DO UNTIL Ni = nmp + 1
x%(Bi) = x%(Ni): y%(Bi) = y%(Ni)
Bi = Bi + 1: Ni = Ni + 1
LOOP
nmp = nmp - (Ni - Bi): y%(nmp) = 0
GOSUB Kline
GOTO DrawMap
Kline: FOR i = LNptr TO LNi
LN$(i) = LN$(i + 1)
NEXT i
LNi = LNi - 1
RETURN
MapPoint:
IF Z < 2 THEN Z = 2: LNptr = 1: BEEP
IF Z > nmp - 1 THEN Z = Z - 1: BEEP
IF x%(Z) = 0 THEN
IF a$ = "-" THEN
LNptr = LNptr - 1: Z = Z - 1
ELSE LNptr = LNptr + 1: Z = Z + 1
END IF
END IF
IF LNptr < 0 THEN LNptr = 0
IF Display$ = "MAP" THEN
LOCATE 22, 1
PRINT "Fture#"; LNptr; TAB(12); LEFT$(LN$(LNptr) + " ", 12);
END IF
DrwMpPt: IF Display$ <> "MAP" THEN RETURN
CIRCLE (Xtest, Ytest), 10, 0 'Erase old circle
Xtest = KP * (x%(Z) - dx) + 320: Ytest = KP * (y%(Z) - dy) + Ycen
CIRCLE (Xtest, Ytest), 10, 15
LOCATE 23, 1: PRINT "MapPt#"; Z;
IF Z > 999 THEN PRINT TAB(13); "val:"; ELSE PRINT TAB(12); "vals:";
PRINT TAB(17); x%(Z); TAB(23); y%(Z)
RETURN
AddLabel: nml = nml + 1
MLa(nml) = CPY: MLo(nml) = CPX
GOSUB BoxLine23: INPUT "Enter Label Name"; a$: ML$(nml) = a$
GOSUB BoxLine23: INPUT "Begin displaying label at what range?"; a$
a = VAL(a$): IF a <> 0 THEN MLr(nml) = a: ELSE MLr(nml) = 2048
Changed = Changed + 1: GOTO labels
BoxLine23: LOCATE 23, 1: PRINT SPACE$(80); : LOCATE 23, 1: RETURN
ErrorTrap: Fault = ERR: 'Error handling routine
IF ERR = 57 THEN PRINT " I/O-error-User-logoff"; : RESUME
IF ERR = 69 THEN PRINT " Comm-buffer-overflow"; : RESUME
IF ERR = 53 THEN PRINT " file-"; file$; "-not-found": CLOSE : RESUME NEXT
IF ERR = 62 THEN RESUME NEXT
IF ERR = 2 THEN PRINT "SYNTAX-error"
IF ERR = 70 THEN PRINT " WRITE PROTECTED!...": RESUME NEXT
RESET
PRINT : PRINT "Error beyond repair. Number = "; ERR;
INPUT "Hit RETURN to return to DOS"; a$
SYSTEM
MapDIR: CLS : PRINT "MAP FILES DIRECTORY": PRINT
PRINT "To display MAP files, please enter the path to your xxxxxxx.MAP files."
PRINT "For example, the default '\APRS\*.MAP' will show all maps in the APRS"
PRINT "directory. Similarly '*.map' will search your present QB directory."
PRINT "For any other path, enter the full file specification.": PRINT
F$ = "\aprs\*.map"
PRINT "Enter Filespec for searching the DIRECTORY ("; F$; ")";
INPUT a$: IF a$ <> "" THEN F$ = a$
PRINT : PRINT : FILES F$
RETURN
LoadMap: 'Maps are drawn to the default EGA resolution of 640 x 400 (350)
Again: LOCATE 23, 2
INPUT "Which mapfile to look at (ENTER for list, Q to quit)"; a$
IF UCASE$(a$) = "Q" THEN SYSTEM
IF a$ = "" THEN GOSUB MapDIR: GOTO Again
a = INSTR(3, a$, "."): IF a = 0 THEN a$ = a$ + ".map"
file$ = UCASE$(a$): OPEN file$ FOR INPUT AS #3
IF Fault = 53 THEN Fault = 0: PRINT : CLOSE #3: GOTO Again
INPUT #3, LATo: LINE INPUT #3, LatText$
INPUT #3, LONo: LINE INPUT #3, LonText$
INPUT #3, ppdV: LINE INPUT #3, VS$'Pixels per degree horiz
INPUT #3, LATcen: LINE INPUT #3, LATcen$
INPUT #3, LONcen: LINE INPUT #3, LONcen$
INPUT #3, MapRng: LINE INPUT #3, MapRng$
INPUT #3, MinRng: LINE INPUT #3, Mr$
LINE INPUT #3, TextLine$ ' Line of comments or instrutcitons
RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
REM KP = 256 / RS
i = 0: LNi = 0:
DO WHILE NOT EOF(3)
i = i + 1: INPUT #3, x%(i), y: y%(i) = y * Yfactr
IF x%(i) = 0 AND NOT EOF(3) THEN ' Get line color & store with x=0
INPUT #3, y%(i): LNi = LNi + 1: LINE INPUT #3, LN$(LNi)' Save line name
IF y = -1 THEN GOSUB LoadLabels ' All labels listed at end of file
END IF
LOOP: nmp = i 'nmp points to 0,-1 that ends all data (but the value
'of X% and y% are 0,0 until file is saved.
LET CDY = LATcen: CDX = LONcen'Center display on ORIGIN
LET CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
LET Z = 2: LNptr = 1: REM start at first point and first line segment
CLOSE #3: RETURN: REM first X% value is map color. 2nd val is 1st pt
LoadLabels: K = 0
DO WHILE NOT EOF(3)
K = K + 1: INPUT #3, ML$(K), MLa(K), MLo(K), MLr(K)
LOOP
IF MLa(K) = 0 OR MLo(K) = 0 THEN nml = K - 1 ELSE nml = K
RETURN
SaveMap: GOSUB BoxLine23: PRINT "Enter file name to save if other than "; file$;
INPUT a$: IF a$ <> "" THEN file$ = a$
GOSUB BoxLine23: PRINT "Saving map to file named "; file$; " ..."
OPEN file$ FOR OUTPUT AS #4
IF Fault = 70 THEN CLOSE #4: GOTO SaveMap
PRINT #4, LATo; ","; LatText$
PRINT #4, LONo; ","; LonText$
PRINT #4, ppdV; ","; VS$
PRINT #4, LATcen; ","; LATcen$
PRINT #4, LONcen; ","; LONcen$
PRINT #4, MapRng; ","; MapRng$
PRINT #4, MinRng; ","; Mr$
PRINT #4, TextLine$
j = 1
FOR i = 1 TO nmp
IF x%(i) <> 0 THEN WRITE #4, x%(i), INT((y%(i) / Yfactr) + .5)
IF x%(i) = 0 AND i = nmp THEN PRINT #4, " 0,-1"
IF x%(i) = 0 AND i <> nmp THEN
PRINT #4, "0,0"
PRINT #4, y%(i); ","; LN$(j): j = j + 1
END IF
NEXT i
PRINT #4, "0,"; LN$(LNi)
FOR K = 1 TO nml
PRINT #4, ML$(K); ","; : WRITE #4, MLa(K), MLo(K), MLr(K)
NEXT K: CLOSE #4: LOCATE 24, 1:
Changed = 0
IF nmp > MaxNumPoints OR nml > MaxNumLABELS THEN
CLS : LOCATE 9, 29: PRINT "CAUTION!": PRINT : PRINT
IF nmp > MaxNumPoints THEN
PRINT " The number of points is greater than"; MaxNumPoints
END IF
IF nml > MaxNumLABELS THEN
PRINT " The number of LABELS is greater than"; MaxNumLABELS
END IF
LOCATE 18, 12
PRINT " Therefore this map will not work with APRS (yet) "
LOCATE 23, 1: INPUT "HIT Enter to continue..."; a$
END IF: GOTO DrwMPaCur
CurDrwMap: CDX = CPX: CDY = CPY: GOTO DrawMap: REM Re-center at CURSOR location
DrwMPaCur: CPX = CDX: CPY = CDY: GOSUB DrawMap
REM After drawing map, Put cursor at center
RETURN
DrawMap: Display$ = "MAP": COLOR 15, 0
'Draw to range scale RS and center display CDX and CDY
'Original Map was 40 pix-per-deg Horiz and 20 vert for 200 display
'Now ppdH and ppdV are variables. The scaling factor KP is 1 for
'the original map scale.
IF RS < MinRng THEN LET RS = MinRng
IF RS > 8192 THEN RS = 8192
KP = 100 * 120 / (RS * ppdV)'This is to scale it down from the 120 maps
Lfac = COS(CDY / 57.296)
dx = ppdV * (LONo - CDX)
dy = (LATo - CDY) * ppdV * Yfactr
CLS : LOCATE 1, 2: PRINT "Redrawing Map"
REM first put ORIGIN and map CENTER on the map
LINE (320 - KP * dx, Ycen - KP * dy)-(960 - KP * dx, Ycen - KP * dy), 14
LINE (320 - KP * dx, Ycen - KP * dy)-(320 - KP * dx, 3 * Ycen - KP * dy), 14
CMX = 320 + KP * (CDX - LONcen) * ppdV
CMY = Ycen + KP * (CDY - LATcen) * ppdV * Yfactr
LINE (CMX - 27, CMY)-(CMX + 27, CMY), 14
LINE (CMX, CMY - 20)-(CMX, CMY + 20), 14
CIRCLE (CMX, CMY), 10, 14
CIRCLE (320 - KP * dx, Ycen - KP * dy), 12, 14
FOR i = 0 TO nmp - 1
x = 320 + KP * (x%(i) - dx): y = Ycen + KP * (y%(i) - dy)
X1 = 320 + KP * (x%(i + 1) - dx): Y1 = Ycen + KP * (y%(i + 1) - dy)
IF x%(i + 1) <> 0 THEN
IF RdsOn OR LineColor <> 12 THEN LINE (x, y)-(X1, Y1), LineColor
ELSE
LineColor = y%(i + 1): i = i + 1
IF Display$ = "SHOW" AND LineColor > 8 THEN LineColor = LineColor - 8
END IF
NEXT i
GOSUB cursor
GOSUB MapPoint: REM Redraw MapPoint
IF Display$ = "SHOW" THEN
GOSUB ShowMaps
ELSE
LOCATE 25, 1: PRINT "Use +/- to move MAPpoint. N/P for Next/Previous Feature. H for HELP!.";
LOCATE 1, 61
PRINT "POINTS"; nmp; "= "; INT((nmp / MaxNumPoints) * 100); "%";
LOCATE 2, 61
PRINT "LABELS "; nml; "= "; INT((nml / MaxNumLABELS) * 100); "%";
LOCATE 3, 61: PRINT "CENTER "; MID$(STR$(LATcen), 2, 5);
LOCATE 3, 75: PRINT MID$(STR$(LONcen), 2, 5)
LOCATE 4, 61: PRINT "SCALE (ppd)"; ppdV
LOCATE 5, 69: PRINT "Range"; MapRng
END IF
labels:
IF Labls THEN
FOR i = 1 TO nml ' Now plot labels on map
IF RS <= MLr(i) OR Key$ = "S" THEN
LET x = 320 + KP * (CDX - MLo(i)) * ppdV
LET y = Ycen + KP * (CDY - MLa(i)) * ppdV * Yfactr
IF Tags AND y > 14 * Yfactr AND y < 350 * Yfactr AND x > 8 * (LEN(ML$(i)) + 1) AND x < 632 THEN
LOCATE y / (14 * Yfactr), (x / 8) - LEN(ML$(i)): PRINT ML$(i);
END IF
END IF
NEXT i
END IF
GOSUB ShowMap: RETURN
ShowMap: REM this shows the map boarder of the loaded map
x = 320 + KP * (CDX - LONcen) * ppdV
y = Ycen + KP * (CDY - LATcen) * ppdV * Yfactr
by = MapRng * KP * ppdV * Yfactr / 60
bx = by * 640 / (400 * Yfactr) * Lfac
C = 15
LINE (x - bx, y - by)-(x + bx, y + by), C, B
RETURN
cursor: CIRCLE (CUX, CUY), 4, 0
CUX = 320 + KP * (CDX - CPX) * ppdV
CUY = Ycen + KP * (CDY - CPY) * ppdV * Yfactr
CIRCLE (CUX, CUY), 4, 14
x = INT(CPX): y = INT(CPY): Xm = (CPX - x) * 60: Ym = (CPY - y) * 60
x$ = RIGHT$(STR$(x), 3) + " "
LOCATE 1, 2: PRINT "RNG"; RIGHT$(" " + STR$(RS), 4) + " "
LOCATE 2, 2: PRINT "LAT "; y; MID$(STR$(Ym) + " ", 2, 5)
LOCATE 3, 2: PRINT "LON "; x$; MID$(STR$(Xm) + " ", 2, 5)
LOCATE 24, 1: PRINT "Cursor coordnts:"; TAB(17);
PRINT INT(.5 + dx + (CUX - 320) / KP); TAB(23); INT(.5 + dy + (CUY - Ycen) / KP);
REM LOCATE 24, 55: PRINT "Degrees: ";
REM PRINT LEFT$(STR$(CPY) + " ", 7); LEFT$(STR$(CPX) + " ", 7);
LOCATE 1, 16: PRINT "Decimal";
LOCATE 2, 15: PRINT LEFT$(STR$(CPY) + " ", 8);
LOCATE 3, 15: PRINT LEFT$(STR$(CPX) + " ", 8);
LINE (0, 0)-(178, 42 * Yfactr), 12, B'Box around it
LINE (0, 0)-(116, 42 * Yfactr), 12, B'Box around it
LET a$ = "": LET B$ = "": RETURN
HELP: CLS : COLOR 15, 1: LINE (0, 0)-(639, 18 * Yfactr), 14, BF
LOCATE 1, 20: PRINT " MAPFIX.bas HELP SCREEN Ver 3.06 "
LOCATE 3, 1
PRINT " The cursor is shown in LAT/LON, map offset and decimal degrees. The ORIGIN,"
PRINT " CENTER and BOARDER are shown, but remember that only the CENTER and RANGE in"
PRINT " the MAPLIST.map are actually used in APRS. Labels are right justified about"
PRINT " where a period (.) should be. CALLS & objects will be left justified."
PRINT ""
PRINT " H - HELP screen D - Directory of maps alt-A Add point alt-C Center point"
PRINT " G - Go To Point F - Find PT @ Cursor alt-D Delete point alt-R Range"
PRINT " L - Labels off S - Show all labels alt-K Kill Feature "
PRINT " M - MAPLIST.map O - Other map borders alt-L Add LABEL alt-T Trim Border pts"
PRINT " N - Next Feature R - RESET POINTERS alt-M Move point"
PRINT " P - Prev Feature Q - QUIT alt-N New Feature ^S SAVE MAP FILE!"
PRINT
PRINT " On the MAP screen, use the white arrow keys with NumLock off for best movement"
PRINT " Space bar - Draw map"
PRINT " Arrow Keys - Move cursor. (use Shift with NumLock off to move faster)"
PRINT " Home (Shift) - Home the map to cursor (Shift-Home the map to ORIGIN)"
PRINT " PgUp, PgDn - Change map scale up/dn by 2 (use CTRL for factor of 8)"
PRINT " End - Redraw map centered on CENTER"
PRINT " Gray +/- keys - Move MapPoint to next point within Feature"
PRINT
IF Display$ <> "HELP" THEN
LOCATE 25, 1
PRINT " HIT H AGAIN FOR MORE HELP SCREENS, OR SPACE BAR FOR MAP...";
END IF
Display$ = "HELP"
LINE (0, 0)-(634, 348 * Yfactr), 15, B
RETURN
REM ************* HERE IS THE CODE BROUGHT IN FROM APRS ***************
LdMapLst: MapListLoaded = -1
F$ = "Maplist.map": OPEN F$ FOR INPUT AS #3
i = 1: IF Fault = 53 THEN STOP
INPUT #3, CDY: LINE INPUT #3, a$: DfltY = CDY
INPUT #3, CDX: LINE INPUT #3, a$: DfltX = CDX
INPUT #3, BestRng: LINE INPUT #3, a$: DfltR = BestRng
INPUT #3, GMToffset: LINE INPUT #3, a$
WHILE a$ <> "* BEGIN *": LINE INPUT #3, a$: WEND ' Skip comment block
RS = BestRng: REM center display
RS = 2 ^ INT(LOG(RS) / LOG(2))'Rng is intgr power of 2
CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
WHILE NOT EOF(3) AND i <= UBOUND(MapName$)
INPUT #3, MapName$(i), LATcen(i), LONcen(i), MapMax(i)
LINE INPUT #3, Comment$(i)' IGNORE ALL comment fields
REM now ignore maps that start with a *
IF LEFT$(MapName$(i), 1) <> "*" THEN NumGood = NumGood + 1
NumMaps = i: i = i + 1
WEND: CLOSE #3
IF NumGood >= MaxNumMAPS - 1 THEN
CLS : LOCATE 2, 5
PRINT "WARNING: Too many ACTIVE MAPS (more than"; MaxNumMAPS; ") in MAPLIST.map file for APRS"
LOCATE 4, 10: PRINT "Use EDITOR to suppress mapnames with an (*) that you don't need."
PRINT : PRINT : PRINT
INPUT "HIT RETURN to continue"; a$
END IF
RETURN
ListMAPlist: IF NOT MapListLoaded THEN GOSUB LdMapLst
GOSUB ListHeader
FOR i = 1 TO NumMaps
IF i / 19 = INT(i / 19) THEN
LOCATE 25, 1: PRINT "HIT RETURN to continue"; : INPUT a$
GOSUB ListHeader
END IF
PRINT MapName$(i); TAB(14);
PRINT INT(LATcen(i) * 100) / 100; TAB(21); INT(LONcen(i) * 100) / 100;
PRINT TAB(29); MapMax(i); TAB(36); LEFT$(Comment$(i), 43)
NEXT i
LOCATE 25, 1: PRINT "LIST COMPLETE. CONTINUE WITH NEXT MAPFIX COMMAND...";
RETURN
ListHeader: CLS
PRINT "MAPS in MAPLIST.map (*MAPS are suppressed) [For now, use EDITOR to modify]"
PRINT :
PRINT "MAP NAME LATcen LONcen RANGE COmments"
PRINT "------------ ------ ------- ----- -------------------------------------------"
RETURN
DrwAndShow: IF NOT MapListLoaded THEN GOSUB LdMapLst
Display$ = "SHOW": GOSUB DrwMPaCur
ShowMaps:
LOCATE 25, 1: PRINT " Drawing all maps >"; MapSize;
PRINT "mi. F3 to see smaller, F4 for bigger, SPACE to cancel.";
LINE (0, 336 * Yfactr)-(639, 349 * Yfactr), 14, B
FOR i = 1 TO NumMaps
Lfac = COS(CDY / 57.296)
Hfac = (640 / 350) * (3 / 4) * Lfac: Sfac = 50 * 200 / RS
x = 320 + Sfac * (CDX - LONcen(i)) * Hfac
y = Ycen + Sfac * (CDY - LATcen(i)) * Yfactr
dy = MapMax(i) * Sfac * Yfactr / 60
dx = dy * 640 / (400 * Yfactr) * Lfac
C = 15
IF MapMax(i) > 32 THEN C = 14
IF MapMax(i) > 64 THEN C = 12
IF MapMax(i) > 128 THEN C = 11
IF MapMax(i) > 256 THEN C = 13
IF MapMax(i) > MapSize THEN
LINE (x - dx, y - dy)-(x + dx, y + dy), C, B
IF y + dy > 14 * Yfactr AND y + dy < 350 * Yfactr THEN
IF x + dx > 8 * (LEN(MapName$(i)) + 1) AND x + dx < 632 THEN
LOCATE (y + dy) / (14 * Yfactr), (x + dx) / 8 - LEN(MapName$(i))
IF MapMax(i) > RS / 4 THEN PRINT MapName$(i);
END IF
END IF
END IF
NEXT i: RETURN
END